home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / pas_all.zip / TI993.ASC < prev    next >
Text File  |  1992-08-12  |  8KB  |  397 lines
  1.  
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.   PRODUCT  :  Turbo Pascal                           NUMBER  :  993
  9.   VERSION  :  6.0
  10.        OS  :  DOS
  11.      DATE  :  August 12, 1992                          PAGE  :  1/6
  12.  
  13.     TITLE  :  Different Colors in Turbo Vision.
  14.  
  15.  
  16.  
  17.  
  18.   Program ColorTV;
  19.  
  20.   uses Objects, Drivers, Views, Menus, Dialogs, App, StdInput;
  21.  
  22.   const
  23.     cmButton  = 101;
  24.     cmNewWin  = 102;
  25.     cmNewDlg  = 103;
  26.  
  27.     WinCount : integer = 0;  { number of current windows }
  28.  
  29.   type
  30.  
  31.     PApp = ^TApp;
  32.     TApp = object(TApplication)
  33.       procedure InitMenuBar; virtual;
  34.       procedure InitStatusLine; virtual;
  35.       procedure HandleEvent(var Event : TEvent); virtual;
  36.       procedure NewWindow;
  37.       procedure NewDialog;
  38.       function  GetPalette : PPalette; virtual;
  39.     end;
  40.  
  41.     PWin = ^TWin;
  42.     TWin = object(TWindow)
  43.       constructor Init(Bounds: TRect; WinTitle: String;
  44.                        WindowNo: Word);
  45.       function GetPalette : PPalette; virtual;
  46.     end;
  47.  
  48.     PInLine = ^TInLine;
  49.     TInLine = object(TInputReal)
  50.       function GetPalette : PPalette; virtual;
  51.     end;
  52.  
  53.     PDlg = ^TDlg;
  54.     TDlg = object(TDialog)
  55.       function GetPalette : PPalette; virtual;
  56.     end;
  57.  
  58.  
  59.   { TWin }
  60.   constructor TWin.Init(Bounds: TRect; WinTitle: String;
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.   PRODUCT  :  Turbo Pascal                           NUMBER  :  993
  75.   VERSION  :  6.0
  76.        OS  :  DOS
  77.      DATE  :  August 12, 1992                          PAGE  :  2/6
  78.  
  79.     TITLE  :  Different Colors in Turbo Vision.
  80.  
  81.  
  82.  
  83.  
  84.                         WindowNo: Word);
  85.   var
  86.     S : string[3];
  87.     R : TRect;
  88.     MyInputLine : PInLine;
  89.   begin
  90.     Str(WindowNo, S);
  91.     TWindow.Init(Bounds, WinTitle + ' ' + S, wnNoNumber);
  92.     GetClipRect(Bounds);
  93.     Bounds.Grow(-1,-1);
  94.  
  95.     { insert input string }
  96.     R.Assign(8, 2, 20, 3);
  97.     Insert(New(PInLine, Init(R, 12)));
  98.  
  99.     { insert button }
  100.     R.Assign(8, 5, 20, 7);
  101.     Insert(New(PButton, Init(R, '~O~k', cmButton, bfDefault)));
  102.  
  103.     { move to the top }
  104.     SelectNext(false);
  105.  
  106.   end;
  107.  
  108.   function TWin.GetPalette : PPalette;
  109.   { add color indexes to TWin to allow button to be displayed in }
  110.   { the window.  notice that TButton's palette starts mapping    }
  111.   { from 10 - 15, and TWindow's palette runs from 1 - 8, there-  }
  112.   { fore add the indexes for the button on the end of TWin       }
  113.   { palettes.                                                    }
  114.   const
  115.     CWin = CBlueWindow + #0#41#42#43#44#45#64;
  116.     PWin : string[Length(CWin)] = CWin;
  117.   begin
  118.     GetPalette := @ PWin;
  119.   end;
  120.  
  121.   { TApp }
  122.   procedure TApp.InitMenuBar;
  123.   var
  124.     Menu: TRect;
  125.   begin
  126.     GetExtent(Menu);
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.   PRODUCT  :  Turbo Pascal                           NUMBER  :  993
  141.   VERSION  :  6.0
  142.        OS  :  DOS
  143.      DATE  :  August 12, 1992                          PAGE  :  3/6
  144.  
  145.     TITLE  :  Different Colors in Turbo Vision.
  146.  
  147.  
  148.  
  149.  
  150.     Menu.B.Y := Menu.A.Y + 1;
  151.     MenuBar := New(PMenuBar, Init(Menu, NewMenu(
  152.       NewSubMenu('~W~indow', hcNoContext, NewMenu(
  153.         NewItem('~W~indow', '', kbF4, cmNewWin, hcNoContext,
  154.         NewItem('~D~ialog', '', kbF5, cmNewDlg, hcNoContext,
  155.         NewLine(
  156.         NewItem('~C~lose', 'Alt-F3', kbAltF3, cmClose, hcNoContext,
  157.         NewItem('E~x~it', 'Alt-X', kbAltX, cmQuit, hcNoContext,
  158.         nil)))))),
  159.       nil))));
  160.   end;
  161.  
  162.   procedure TApp.InitStatusLine;
  163.   var
  164.     Line: TRect;
  165.   begin
  166.     GetExtent(Line);
  167.     Line.A.Y := Line.B.Y-1;
  168.     StatusLine := New(PStatusLine, Init(Line,
  169.       NewStatusDef(0, $FFFF,
  170.         NewStatusKey('', kbF10, cmMenu,
  171.         NewStatusKey('~Alt-X~ Exit', kbAltX, cmQuit,
  172.         NewStatusKey('~F4~ Window', kbF4, cmNewWin,
  173.         NewStatusKey('~F5~ Dialog', kbF5, cmNewDlg,
  174.         NewStatusKey('~Alt-F3~ Close', kbAltF3, cmClose,
  175.         nil))))),
  176.       nil)));
  177.   end;
  178.  
  179.   procedure TApp.NewWindow;
  180.   var
  181.     Window : PWin;
  182.     Box    : TRect;
  183.   begin
  184.     Inc(WinCount);
  185.     Box.Assign(0, 0, 30, 8);
  186.     Box.Move(Random(34), Random(11));
  187.     Window := New(PWin, Init(Box, 'Test Window', WinCount));
  188.     DeskTop^.Insert(Window);
  189.   end;
  190.  
  191.   procedure TApp.HandleEvent(var Event: TEvent);
  192.   begin
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.   PRODUCT  :  Turbo Pascal                           NUMBER  :  993
  207.   VERSION  :  6.0
  208.        OS  :  DOS
  209.      DATE  :  August 12, 1992                          PAGE  :  4/6
  210.  
  211.     TITLE  :  Different Colors in Turbo Vision.
  212.  
  213.  
  214.  
  215.  
  216.     TApplication.HandleEvent(Event);
  217.     if Event.What = evCommand then
  218.     begin
  219.       case Event.Command of
  220.         cmNewWin : NewWindow;
  221.         cmNewDlg : NewDialog;
  222.         cmButton : ;
  223.       else
  224.         Exit;
  225.       end;
  226.       ClearEvent(Event);
  227.     end;
  228.   end;
  229.  
  230.   procedure TApp.NewDialog;
  231.   var
  232.     Dialog     : PDlg;
  233.     R          : TRect;
  234.     C          : Word;
  235.   begin
  236.  
  237.     R.Assign(25, 5, 55, 13);
  238.     Dialog := New(PDlg, Init(R, 'Test Dialog'));
  239.  
  240.     with Dialog^ do
  241.     begin
  242.  
  243.       { message }
  244.       R.Assign(9, 2, 27, 3);
  245.       Insert(New(PStaticText, Init(R, 'Error Message')));
  246.  
  247.       { insert button }
  248.       R.Assign(10, 5, 20, 7);
  249.       Insert(New(PButton, Init(R, '~O~k', cmOK, bfDefault)));
  250.  
  251.     end;
  252.  
  253.     C := DeskTop^.ExecView(Dialog);
  254.  
  255.     Dispose(Dialog, Done);
  256.   end;
  257.  
  258.   function TApp.GetPalette : PPalette;
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271.  
  272.   PRODUCT  :  Turbo Pascal                           NUMBER  :  993
  273.   VERSION  :  6.0
  274.        OS  :  DOS
  275.      DATE  :  August 12, 1992                          PAGE  :  5/6
  276.  
  277.     TITLE  :  Different Colors in Turbo Vision.
  278.  
  279.  
  280.  
  281.  
  282.   { this is the palette that all other views are mapped to. }
  283.   { the first 64 (0..63) are defined, any other colors are  }
  284.   { added from 64 on.  the #$10 is for TWin for the back-   }
  285.   { ground color for the button.  from $47 on maps the new  }
  286.   { color for TDlg and its views.                           }
  287.   const
  288.     CApp = CColor + #$10#$47#$4E#$40#$4F#$30#$3E;
  289.     PApp : string[Length(CApp)] = CApp;
  290.   begin
  291.     GetPalette := @ PApp;
  292.   end;
  293.  
  294.   { TInLine }
  295.   function TInLine.GetPalette : PPalette;
  296.   { color indexes into TWin color palette }
  297.   const
  298.     CInLine = #4#4#3#3;
  299.     PInLine : string[Length(CInLine)] = CInLine;
  300.   begin
  301.     GetPalette := @ PInLine;
  302.   end;
  303.  
  304.   { TDlg }
  305.   function TDlg.GetPalette : PPalette;
  306.   { when replacing colors for a view must replace the entire   }
  307.   { string.  notice that any color > 63 maps to a user defined }
  308.   { color from TApp's palette (65 = $47, 66 = $4E, etc.).      }
  309.   { i.e.                                                       }
  310.   { index 2, the active frame maps to 65 which is color $47    }
  311.   {          (or grey on red).                                 }
  312.   { index 3, the frame icon maps to 66->$4E (yellow on red).   }
  313.   { index 46, the button shadow maps to 67->$40 (black on rec).}
  314.   { index 37, the statictext maps to 68->$47 (white on red).   }
  315.   {           (no reason 46 is before 38).                     }
  316.   { index 41-43, button stuff 69->$30 (cyan on black).         }
  317.   { index 45, button shortcut 70->$3E (cyan on yellow).        }
  318.   const
  319.     CDlg = #32#65#66#35#36#68#38#39#40#69#69#69#44#70#67#47#48#49 +
  320.            #50#51#52#53#54#55#56#57#58#59#60#61#62#63;
  321.     PDlg : string[Length(CDlg)] = CDlg;
  322.   begin
  323.    GetPalette := @ PDlg;
  324.   end;
  325.  
  326.  
  327.  
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338.   PRODUCT  :  Turbo Pascal                           NUMBER  :  993
  339.   VERSION  :  6.0
  340.        OS  :  DOS
  341.      DATE  :  August 12, 1992                          PAGE  :  6/6
  342.  
  343.     TITLE  :  Different Colors in Turbo Vision.
  344.  
  345.  
  346.  
  347.  
  348.   var
  349.     MyApp : TApp;
  350.  
  351.   { main }
  352.   begin
  353.  
  354.     MyApp.Init;
  355.     MyApp.Run;
  356.     MyApp.Done;
  357.  
  358.   end.
  359.  
  360.   DISCLAIMER: You have the right to use this technical information
  361.   subject to the terms of the No-Nonsense License Statement that
  362.   you received with the Borland product to which this information
  363.   pertains.
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  
  378.  
  379.  
  380.  
  381.  
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389.  
  390.  
  391.  
  392.  
  393.  
  394.  
  395.  
  396.  
  397.